#lang scheme

; TODO: rename, it is not a deque actually
;       it is list with tail-pointer
; TODO: deque->iter
; TODO: deque->iter/wait-on-empty

(provide deque
         deque?
         deque-length
         deque-head
         deque-tail
         deque-push-head!
         deque-push-tail!
         deque-pop-head!
         ;O(n) deque-pop-tail!
         ;deque-try-pop-head!
         ;deque-try-pop-tail!
         deque-for-each
         build-deque
         )

(require "tidbits.ss"
         "test.ss"
         scheme/mpair)

; internal struct
(define-struct %deque (hd tl len) #:mutable #:transparent) ; TODO?: semaphore
(define deque? %deque?)
(define deque-length %deque-len)

(define (deque . elts)
  (let loop ([hd null] [tl null] [length 0] [elts elts])
    (if (null? elts)
        (make-%deque hd tl length)
        (let ([newcons (mcons (car elts) null)])
          (if (null? tl)
              (loop newcons newcons 1 (cdr elts))
              (begin (set-mcdr! tl newcons)
                     (loop hd newcons (add1 length) (cdr elts))))))))

(define (build-deque len proc)
  (let ([d (deque)])
    (dotimes (i len) (deque-push-tail! d (proc i)))
    d))

(define (deque-head d)  (mcar (%deque-hd d)))

(define (deque-tail d)  (mcar (%deque-tl d)))

(define (deque-push-head! d x)
  (let ([newcell (mcons x (%deque-hd d))])
    (set-%deque-hd! d newcell)
    (when (null? (%deque-tl d))
      (set-%deque-tl! d newcell)))
  (set-%deque-len! d (add1 (%deque-len d)))
  (void))

(define (deque-push-tail! d x)
  (let ([newcell (mcons x null)]
        [tl (%deque-tl d)])
    (if (null? tl)
        (set-%deque-hd! d newcell)
        (set-mcdr! tl newcell))
    (set-%deque-tl! d newcell))
  (set-%deque-len! d (add1 (%deque-len d)))
  (void))

(define (deque-for-each proc d)
  (mfor-each proc (%deque-hd d)))

(define (deque-pop-head! d)
  (begin0 (mcar (%deque-hd d))
          (let ([newhd (mcdr (%deque-hd d))])
            (set-%deque-hd! d newhd)
            (when (null? newhd)
              (set-%deque-tl! d newhd)))
          (set-%deque-len! d (sub1 (%deque-len d)))))


; +TESTS
;(equal! (deque)         #(() () 0) )
;(equal! (deque "q")     (vector (mlist "q") (mlist "q") 1) )
;(equal! (deque 1 2 3)   (vector (mlist 1 2 3) (mlist 3) 3) )

;(deque-for-each o (deque 1 2 3))
         
(=! 1 (deque-head (deque 1 2 3)))
(=! 3 (deque-tail (deque 1 2 3)))
(let ([d (deque "q")])
  (eq! (deque-head d) (deque-tail d)))

(define d (deque "w"))
(equal! (%deque-hd d) (mlist "w"))
(=! (deque-length d) 1)
(eq! (last (mlist->list (%deque-hd d))) (deque-tail d))

(deque-push-head! d "q")
(equal! (%deque-hd d) (mlist "q" "w"))
(=! (deque-length d) 2)
(eq! (last (mlist->list (%deque-hd d))) (deque-tail d))

(deque-push-tail! d "e")
(equal! (%deque-hd d) (mlist "q" "w" "e"))
(=! (deque-length d) 3)
(eq! (last (mlist->list (%deque-hd d))) (deque-tail d))

(let ([d1 (deque)]
      [d2 (deque)])
  (equal! (deque-push-tail! d2 "q")
          (deque-push-head! d1 "q")))
; -TESTS

#|
(define d4 (deque 1 2 3))
(deque-pop-head! d4)
d4
(deque-pop-head! d4)
d4
(deque-pop-head! d4)
d4
|#
;(deque-pop-head! d4)
;d4

